Business
Jobs
  • About Us
  • Solutions
    • Job Postings
      Post your job and receive qualified candidates in 48h.
    • Candidate Assessments
      500+ technical and psychological tests, plus anti-fraud.
    • Headhunting
      Tailor-made executive search from start to finish.
    • Payroll + EOR
      Payroll dispersal and EOR across 15+ LATAM countries.
  • Pricing
  • Jobs

0

365
Views
Subscription out of Range with Set TargetWS = Workbooks("Result.xlsx").Worksheet(2)

I am new to VBA and trying to select few column based on header of 2 file and compare them. To achieve this I am copying the column based on header such xx,yy,zz from 2 sheet to new sheet leaving few column as blank to separate 2 sheet data and compare the column. Diff will be highlighted in red.

enter image description here

Tried below code to copy data but I am getting subscription out of range for target file(highlighted below).

Sub CopyByHeader()

    Dim CurrentWS As Worksheet
    Set CurrentWS = ActiveSheet

    Dim SourceWS As Worksheet
    Set SourceWS = Workbooks("ALL_01.00.xls").Worksheets(1)
    Dim SourceHeaderRow As Integer: SourceHeaderRow = 1
    Dim SourceCell As Range
    
    Dim fl As Object
    Set fl = CreateObject("scripting.filesystemobject").GetFile("Result.xlsx")

    If fl Is Nothing Then
    Workbooks.Add.SaveAs Filename:="Result"
    End If
    
    Dim TargetWS As Worksheet
    **Set TargetWS = Workbooks("Result.xlsx").Worksheet(2)**
    Dim TargetHeader As Range
    Set TargetHeader = TargetWS.Range("A1:AX1")
    Dim RealLastRow As Long
    Dim SourceCol As Integer
    Dim Header() As Variant
    Dim k As Integer
    HeaderList = Array("xx", "yy", "zz")
    SourceWS.Activate
    For Each Cell In TargetHeader
        If Cell.Value <> "" Then
            Set SourceCell = Rows(SourceHeaderRow).Find _
                (Cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
            If Not SourceCell Is Nothing Then
                SourceCol = SourceCell.Column
                RealLastRow = Columns(SourceCol).Find("*", LookIn:=xlValues, _
                SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                If RealLastRow > SourceHeaderRow Then
                    Range(Cells(SourceHeaderRow + 1, SourceCol), Cells(RealLastRow, _
                        SourceCol)).Copy
                    TargetWS.Cells(2, Cell.Column).PasteSpecial xlPasteValues
                End If
            End If
        End If
    Next

    CurrentWS.Activate

End Sub
about 4 years ago · Santiago Trujillo
Answer question
Find remote jobs

Discover the new way to find a job!

Top jobs
Top job categories
Business
Post vacancy Pricing Sales
Legal
Terms and conditions Privacy policy
© 2026 PeakU Inc. All Rights Reserved.
Andres GPT
Show me some job opportunities
There's an error!